home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / BUTTEST.ARJ / BUTTON3.PAS next >
Pascal/Delphi Source File  |  1992-01-31  |  12KB  |  438 lines
  1.  
  2.                    {BUTTON3.PAS creates BUTTON3.TPU Unit}
  3.      {From the book "OBJECT ORIENTED PROGRAMMING IN TURBO PASCAL 5.5"}
  4.  
  5. Unit Button3;
  6.  
  7.             {=============================================}
  8.             {This version of the unit uses virtual methods}
  9.             {=============================================}
  10.  
  11. Interface
  12.  
  13. Type
  14.     STR40 = string[40];
  15.  
  16.     Point = object
  17.           X,Y,Color : integer;
  18.           Constructor Init;
  19.           Procedure Move(Ptx,Pty : integer);
  20.           Procedure Draw; virtual;
  21.           Procedure Create(Ptx,Pty,C : integer);
  22.           Procedure SetColor(C : integer);
  23.           Procedure SetLoc(Ptx,Pty : integer); virtual;
  24.           Procedure Erase; virtual;
  25.           Function GetColor : integer;
  26.           Function GetX : integer;
  27.           Function GetY : integer;
  28.           end; {object}
  29.  
  30.     ButtonType = (Rounded,Square,ThreeD);
  31.  
  32.     Button = object(Point)
  33.            Exist,State,Rotate : boolean;
  34.            FontSize,TypeFace,SizeX,SizeY : integer;
  35.            Style : ButtonType;
  36.            BtnTxt : STR40;
  37.            Constructor Init;
  38.            Procedure Draw; virtual;
  39.            Procedure Create(Ptx,Pty,Width,Height,C : integer; Text : STR40);
  40.            Procedure Erase; virtual;
  41.            Procedure Invert;
  42.            Procedure Move(Ptx,Pty : integer);
  43.            Procedure SetColor(C : integer);
  44.            Procedure SetState(Bstate : boolean);
  45.            Procedure SetLabel(Text : STR40);
  46.            Procedure SetButtonType(WhatType : ButtonType);
  47.            Procedure SetTypeSize(TxtSize : integer);
  48.            Procedure SetTypeFace(TxtFont : integer);
  49.            Function GetWidth : integer;
  50.            Function GetHeight : integer;
  51.            Function GetState  : boolean;
  52.            Function GetTextSize : integer;
  53.            Function GetType : ButtonType;
  54.            Function ButtonHit(MouseX,MouseY : integer) : boolean;
  55.            end; {object}
  56.  
  57. {=========================================================================}
  58.  
  59. Implementation
  60.  
  61. Uses
  62.     Crt,Graph;
  63.  
  64. Type
  65.     RectOutline = array[1..5] of PointType;
  66.  
  67.                 {========================================}
  68.                 {Local procedure used by Button functions}
  69.                 {========================================}
  70.  
  71. Procedure SetOutline(var RectArr : RectOutline; X1,Y1,X2,Y2 : integer);
  72. Begin
  73.      RectArr[1].x := X1;
  74.      RectArr[1].y := Y1;
  75.      RectArr[2].x := X1;
  76.      RectArr[2].y := Y2;
  77.      RectArr[3].x := X2;
  78.      RectArr[3].y := Y2;
  79.      RectArr[4].x := X2;
  80.      RectArr[4].y := Y1;
  81.      RectArr[5].x := X1;
  82.      RectArr[5].y := Y1;
  83. End;
  84.  
  85. {*************************************************************************}
  86.                  {====================================}
  87.                  {Implementation for object type Point}
  88.                  {====================================}
  89.  
  90. Constructor Point.Init;
  91. Begin
  92. End;
  93.  
  94. {*************************************************************************}
  95.  
  96. Procedure Point.SetLoc;
  97. Begin
  98.      X := Ptx;
  99.      Y := Pty;
  100. End;
  101.  
  102. {*************************************************************************}
  103.  
  104. Procedure Point.Draw;
  105. Begin
  106.      PutPixel(X,Y,Color);
  107. End;
  108.  
  109. {*************************************************************************}
  110.  
  111. Procedure Point.Create;
  112. Begin
  113.      SetLoc(Ptx,Pty);
  114.      Color := C;
  115.      Draw;
  116. End;
  117.  
  118. {*************************************************************************}
  119.  
  120. Procedure Point.Erase;
  121. Var
  122.    Temp : integer;
  123. Begin
  124.      Temp := Color;
  125.      Color := GetBkColor;
  126.      Draw;
  127.      Color := Temp;
  128. End;
  129.  
  130. {*************************************************************************}
  131.  
  132. Procedure Point.Move;
  133. Begin
  134.      Erase;
  135.      SetLoc(Ptx,Pty);
  136.      Draw;
  137. End;
  138.  
  139. {*************************************************************************}
  140.  
  141. Procedure Point.SetColor;
  142. Begin
  143.      Color := C;
  144.      Draw;
  145. End;
  146.  
  147. {*************************************************************************}
  148.  
  149. Function Point.GetColor;
  150. Begin
  151.      GetColor := Color;
  152. End;
  153.  
  154. {*************************************************************************}
  155.  
  156. Function Point.GetX;
  157. Begin
  158.      GetX := X;
  159. End;
  160.  
  161. {*************************************************************************}
  162.  
  163. Function Point.GetY;
  164. Begin
  165.      GetY := Y;
  166. End;
  167.  
  168. {*************************************************************************}
  169.                {=====================================}
  170.                {Implementation for object type Button}
  171.                {=====================================}
  172.  
  173. Constructor Button.Init;
  174. Begin
  175.      Exist := False;
  176.      SetTypeSize(10);
  177.      SetTypeFace(TriplexFont);
  178. End;
  179.  
  180. {*************************************************************************}
  181.  
  182. Procedure Button.Draw;
  183. Const
  184.      Radius = 6;        {Radius of corners on rounded buttons}
  185.      Offset = 3;        {Offset for fill                     }
  186. Var
  187.    RectArr : RectOutline;
  188.    AlignX,AlignY,TempSize,TextLen,I,BtnWd,BtnHt,TextDir : integer;
  189. Begin
  190.      SetViewPort(X,Y,X+SizeX,Y+SizeY,ClipOn);
  191.      Graph.SetColor(Color);
  192.      Case Style of
  193.           Square  : begin
  194.                          Graph.Rectangle(0,0,SizeX,SizeY);
  195.                          BtnWd := SizeX - 10;
  196.                          BtnHt := SizeY - 10;
  197.                     end;
  198.           ThreeD  : begin
  199.                          Graph.Rectangle(0,0,SizeX,SizeY);
  200.                          SetOutline(RectArr,1,1,SizeX-1,SizeY-1);
  201.                          SetFillStyle(CloseDotFill,Color);
  202.                          SetLineStyle(UserBitLn,0,NormWidth);
  203.                          FillPoly(SizeOf(RectArr) div
  204.                                   SizeOf(PointType), RectArr);
  205.                          SetLineStyle(SolidLn,0,NormWidth);
  206.                          Graph.Rectangle(2*Radius,2*Radius,
  207.                                          SizeX-2*Radius,SizeY-2*Radius);
  208.                          Line(0,0,2*Radius,2*Radius);
  209.                          Line(0,SizeY,2*Radius,SizeY-2*Radius);
  210.                          Line(SizeX,0,SizeX-2*Radius,2*Radius);
  211.                          Line(SizeX,SizeY,SizeX-2*Radius,SizeY-2*Radius);
  212.                          BtnWd := SizeX-4*Radius;
  213.                          BtnHt := SizeY-4*Radius;
  214.                     end
  215.           else
  216.                     begin
  217.                          Style := Rounded;
  218.                          Graph.Arc(SizeX-Radius,Radius,0,90,Radius);
  219.                          Graph.Arc(Radius,Radius,90,180,Radius);
  220.                          Graph.Arc(Radius,SizeY-Radius,180,270,Radius);
  221.                          Graph.Arc(SizeX-Radius,SizeY-Radius,270,360,Radius);
  222.                          Graph.Line(Radius,0,SizeX-Radius,0);
  223.                          Graph.Line(Radius,SizeY,SizeX-Radius,SizeY);
  224.                          Graph.Line(0,Radius,0,SizeY-Radius);
  225.                          Graph.Line(SizeX,Radius,SizeX,SizeY-Radius);
  226.                          BtnWd := SizeX-2*Radius;
  227.                          BtnHt := SizeY-2*Radius;
  228.                     end;
  229.      end; {of case}
  230.  
  231.      Case Style of
  232.           Square,
  233.           Rounded : SetOutline(RectArr,Offset,Offset,
  234.                                SizeX-Offset,SizeY-Offset);
  235.           ThreeD  : SetOutline(RectArr,2*Radius+1,2*Radius+1,
  236.                                SizeX-2*Radius-1,SizeY-2*Radius);
  237.      end; {of case{
  238.                               {SHOW STATE}
  239.      if State then
  240.         SetFillStyle(SolidFill,Color)
  241.      else
  242.          SetFillStyle(WideDotFill,Color);
  243.      SetLineStyle(UserBitLn,0,NormWidth);
  244.      FillPoly(SizeOf(RectArr) div SizeOf(PointType),RectArr);
  245.      SetLineStyle(SolidLn,0,NormWidth);
  246.  
  247.                      {ADJUST FONTS AND STRING TO FIT}
  248.      TempSize := FontSize;
  249.      TextDir  := HorizDir;
  250.      if Rotate then
  251.      begin
  252.           TextDir := VertDir;
  253.           TextLen := BtnWd;
  254.           BtnWd   := BtnHt;
  255.           BtnHt   := TextLen;
  256.      end;
  257.      SetTextStyle(TypeFace,TextDir,TempSize);
  258.      for I := FontSize downto 1 do
  259.          if (TextWidth(BtnTxt) > BtnWd) then
  260.             SetTextStyle(TypeFace,TextDir,I)
  261.          else
  262.          if (TextHeight(BtnTxt) > BtnHt) then
  263.             SetTextStyle(TypeFace,TextDir,I);
  264.      TextLen := Ord(BtnTxt[0]);
  265.      while (TextWidth(Copy(BtnTxt,1,TextLen)) > BtnWd) do
  266.            Dec(TextLen);
  267.      AlignX := SizeX div 2 - 3;
  268.      AlignY := SizeY div 2 - 3;   {Fine tune text position}
  269.      if BtnTxt[TextLen] = ' ' then
  270.         Dec(TextLen);
  271.      if State then
  272.         Graph.SetColor(GetBkColor);
  273.  
  274.                             {ADD LABEL}
  275.      OutTextXY(AlignX,AlignY,Copy(BtnTxt,1,TextLen));
  276.      if State then
  277.         Graph.SetColor(Color);
  278.      SetViewPort(0,0,GetMaxX,GetMaxY,ClipOn);
  279. End;
  280.  
  281. {*************************************************************************}
  282.  
  283. Procedure Button.Create;
  284. Begin
  285.      SetViewPort(0,0,GetMaxX,GetMaxY,ClipOn);
  286.      SetTextJustify(CenterText,CenterText);
  287.      SetLoc(Ptx,Pty);
  288.      if Width < 20 then
  289.         SizeX := 20
  290.      else
  291.          SizeX := Width;
  292.      if Height < 20 then
  293.         SizeY := 20
  294.      else
  295.          SizeY := Height;
  296.      if (SizeY > SizeX) then
  297.         Rotate := True
  298.      else
  299.          Rotate := False;
  300.      Color := C;
  301.      State := False;
  302.      Exist := True;
  303.      BtnTxt := Text;
  304.      Draw;
  305. End;
  306.  
  307. {*************************************************************************}
  308.  
  309. Procedure Button.Erase;
  310. Var
  311.    OldColor : integer;
  312. Begin
  313.      if Exist then
  314.      begin
  315.           SetViewPort(X,Y,X+SizeX,Y+SizeY,ClipOn);
  316.           ClearViewPort;
  317.           Exist := False;
  318.      end;
  319. End;
  320.  
  321. {*************************************************************************}
  322.  
  323. Procedure Button.Move;
  324. Begin
  325.      Erase;
  326.      SetLoc(Ptx,Pty);
  327.      Draw;
  328. End;
  329.  
  330. {*************************************************************************}
  331.  
  332. Procedure Button.SetLabel;
  333. Begin
  334.      BtnTxt := Text;
  335.      Draw;
  336. End;
  337.  
  338. {*************************************************************************}
  339.  
  340. Procedure Button.SetColor;
  341. Begin
  342.      Color := C;
  343.      Draw;
  344. End;
  345.  
  346. {*************************************************************************}
  347.  
  348. Procedure Button.SetState;
  349. Begin
  350.      if (State <> BState) then
  351.         Invert;
  352. End;
  353.  
  354. {*************************************************************************}
  355.  
  356. Procedure Button.SetTypeSize;
  357. Begin
  358.      FontSize := TxtSize;
  359. End;
  360.  
  361. {*************************************************************************}
  362.  
  363. Procedure Button.SetTypeFace;
  364. Begin
  365.      TypeFace := TxtFont;
  366. End;
  367.  
  368. {*************************************************************************}
  369.  
  370. Procedure Button.SetButtonType;
  371. Begin
  372.      Style := WhatType;
  373. End;
  374.  
  375. {*************************************************************************}
  376.  
  377. Procedure Button.Invert;
  378. Begin
  379.      State := not State;
  380.      Draw;
  381. End;
  382.  
  383. {*************************************************************************}
  384.  
  385. Function Button.GetWidth;
  386. Begin
  387.      GetWidth := SizeX;
  388. End;
  389.  
  390. {*************************************************************************}
  391.  
  392. Function Button.GetHeight;
  393. Begin
  394.      GetHeight := SizeY;
  395. End;
  396.  
  397. {*************************************************************************}
  398.  
  399. Function Button.GetState;
  400. Begin
  401.      GetState := State;
  402. End;
  403.  
  404. {*************************************************************************}
  405.  
  406. Function Button.GetTextSize;
  407. Begin
  408.      GetTextSize := FontSize;
  409. End;
  410.  
  411. {*************************************************************************}
  412.  
  413. Function Button.GetType;
  414. Begin
  415.      GetType := Style;
  416. End;
  417.  
  418. {*************************************************************************}
  419.  
  420. Function Button.ButtonHit;
  421. Var
  422.    Result : boolean;
  423. Begin
  424.      Result := False;
  425.      if (MouseX >= X) and (MouseX <= X+SizeX) and
  426.         (MouseY >= Y) and (MouseY <= Y+SizeY) then
  427.                 Result := True;
  428.      if Result then
  429.         Invert;
  430.      ButtonHit := Result;
  431. End;
  432.  
  433. {*************************************************************************}
  434.  
  435.  
  436. BEGIN
  437.      {No initialization required}
  438. END.